R/03 reorder.R

In moodymudskipper/ggfun: Tools to apply functions to ggplot objects or their data

#' Reorder Levels of Factor Columns of Data Frames
#'
#' The gg method acts on the underlying data of the gg object input.
#'
#' @param .data a data frame
#' @param ... named arguments of unnamed argument of the form `-col`, if named
#'   the name should correspond to the column to affect and the value will
#'   determine the level's rank. If of form `-col` the level order will be
#'   reversed for this variable.
#' the value should be
#' @param .focus filter to apply on the data before applying the operations that
#'   will define the factor levels
#'
#' @return a data frame
#' @export
#'
#' @examples
#' library(dplyr)
#' head(levels(factor(starwars$homeworld)))
#' head(levels(factor(starwars$species)))
#' levels(factor(starwars$gender))
#' sw <- reorder(starwars, -gender,
#'               homeworld = mean(height,na.rm=T),
#'               species = mean(mass,na.rm=T))
#' head(levels(sw$homeworld))
#' head(levels(sw$species))
#' levels(sw$gender)
reorder.data.frame <- function(.data, ..., .focus = TRUE){
  dots <- rlang::enexprs(...)
  nms <- names(dots)

  # reverse factors for unnamed parameters starting with `-`
  unnamed_dots <- dots[nms == ""]
  illegal_unnamed_lgl <- !purrr::map_lgl(unnamed_dots,
                                   ~length(.)==2 && identical(.[[1]],quote(`-`)) && is.symbol(.[[2]]))
  if (any(illegal_unnamed_lgl))
    stop("Unnamed parameters must be of the form `-symbol`")

  vars_from_unnamed <- purrr::map_chr(unnamed_dots,~as.character(.[[2]]))
  .data[vars_from_unnamed] <-
    purrr::map(.data[vars_from_unnamed],~factor(.,levels=rev(levels(factor(.)))))

  # restrict dots to named variables
  dots <- dots[nms != ""]
  nms <- setdiff(nms, "")

  # order factors according to aggregated/ filtered values
  .data[nms] <- purrr::imap(
    dots, ~ {
      agg <- dplyr::group_by(.data, !!sym(.y))
      agg <- dplyr::filter(agg, !!enquo(.focus))
      agg <- dplyr::summarize(agg, !!.x)
      agg <- dplyr::arrange(agg, !!sym(names(agg)[2]))
      factor(.data[[.y]],union(agg[[1]], .data[[.y]]))
    })
  .data
}

#' @inheritParams reorder.data.frame
#' @param gg object of class gg
#' @export
#' @rdname myPkgSpClass-class
reorder.gg <- ggmethod(reorder)